home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / v3_1 / sbp3_1e.lzh / NLU.PL < prev    next >
Text File  |  1991-10-31  |  10KB  |  444 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7. /* NLU.PL */
  8.  
  9. /***********************************************
  10.  * Demonstration natural language understander *
  11.  * Michael A. Covington         Copyright 1987 *
  12.  * Advanced Computational Methods Center       *
  13.  * University of Georgia                       *
  14.  * Athens, Georgia 30602                       *
  15.  ***********************************************/
  16.  
  17.  
  18. /*****************
  19.  * Preliminaries *
  20.  *****************/
  21.  
  22. :- write('Loading program. Please wait...'),nl,nl.
  23.  
  24. :- ( clause(tokenize(_,_),_) ; consult('tokenize.pl') ).
  25. :- ( clause(readstring(_),_) ; consult('readstr.pl') ).
  26.  
  27. /* Queries will use built-in predicate phrase/2 */
  28.  
  29. :- dynamic dummy_count/1.
  30.  
  31. /* Define the ampersand (&) as a compound goal constructor
  32.    with narrower scope (lower precedence) than the comma. */
  33.  
  34. :- op(950,xfy,&).      /* syntax of & */
  35.  
  36. GoalA & GoalB  :-
  37.     call(GoalA),
  38.     call(GoalB).       /* semantics of & */
  39.  
  40.  
  41. /**********
  42.  * Parser *
  43.  **********/
  44.  
  45. /*
  46.  *   The following code parses each sentence and converts it into
  47.  *   a structure of the form
  48.  *        SentenceType(EntityList,Predicate).
  49.  *   For convenience, each rule is preceded by a comment
  50.  *   summarizing the syntactic structure that it accounts for.
  51.  */
  52.  
  53.  
  54. /*
  55.  *   sentence --> noun_phrase, verb_phrase.
  56.  */
  57.  
  58. sentence(statement([Subj|Tail],Pred)) -->
  59.      noun_phrase(Subj),
  60.      verb_phrase(verb_phrase([Subj|Tail],Pred)).
  61.  
  62.  
  63. /*
  64.  *   sentence --> noun_phrase, copula, noun_phrase.
  65.  *   sentence --> noun_phrase, copula, adj_phrase.
  66.  */
  67.  
  68. sentence(statement([NewSubj],Pred)) -->
  69.      noun_phrase(Subj),
  70.      copula(_),
  71.      (noun_phrase(Comp) ; adj_phrase(Comp)),
  72.      { change_a_to_null(Subj,NewSubj) },
  73.      { NewSubj = entity(S,_,_) },
  74.      { Comp = entity(S,_,Pred) }.
  75.  
  76.  
  77. /*
  78.  *   sentence --> aux_verb, noun_phrase, verb_phrase.
  79.  */
  80.  
  81. sentence(question([Subj|Tail],Pred)) -->
  82.      aux_verb(_),
  83.      noun_phrase(Subj),
  84.      verb_phrase(verb_phrase([Subj|Tail],Pred)).
  85.  
  86.  
  87. /*
  88.  *   sentence --> copula, noun_phrase, noun_phrase.
  89.  *   sentence --> copula, noun_phrase, adj_phrase.
  90.  */
  91.  
  92. sentence(question([NewSubj],Pred)) -->
  93.      copula(_),
  94.      noun_phrase(Subj),
  95.      (noun_phrase(Comp) ; adj_phrase(Comp)),
  96.      { change_a_to_null(Subj,NewSubj) },
  97.      { NewSubj = entity(S,_,_) },
  98.      { Comp = entity(S,_,Pred) }.
  99.  
  100.  
  101. /*
  102.  * change_a_to_null(Entity,NewEntity)
  103.  *
  104.  *   Special rule to change determiner 'a' to 'null'.
  105.  *   Invoked when parsing sentences with copulas so that
  106.  *   "A dog is an animal" will mean "Dogs are animals."
  107.  */
  108.  
  109. change_a_to_null(entity(V,a,C),entity(V,null,C)) :- !.
  110.  
  111. change_a_to_null(X,X). /* if it didn't match the above */
  112.  
  113.  
  114. /*
  115.  *   verb_phrase --> verb, noun_phrase.
  116.  */
  117.  
  118. verb_phrase(verb_phrase([Subj,Obj],Pred)) -->
  119.      verb(V),
  120.      noun_phrase(Obj),
  121.      { Subj = entity(Su,_,_) },
  122.      { Obj  = entity(Ob,_,_) },
  123.      { Pred =.. [V,Su,Ob] }.
  124.  
  125.  
  126. /*
  127.  *   adj_phrase --> adjective.
  128.  */
  129.  
  130. adj_phrase(entity(X,_,Cond)) -->
  131.      adjective(A),
  132.      { Cond =.. [A,X] }.
  133.  
  134.  
  135. /*
  136.  *   noun_phrase --> determiner, noun_group.
  137.  */
  138.  
  139. noun_phrase(entity(X,D,Conds)) -->
  140.      determiner(D),
  141.      noun_group(entity(X,_,Conds)).
  142.  
  143.  
  144. /*
  145.  *   noun_group --> adjective, noun_group.
  146.  */
  147.  
  148. noun_group(entity(X,_,(Cond & Rest))) -->
  149.      adjective(A),
  150.      { Cond =.. [A,X] },
  151.      noun_group(entity(X,_,Rest)).
  152.  
  153.  
  154. /*
  155.  *   noun_group --> common_noun.
  156.  */
  157.  
  158. noun_group(entity(X,_,Cond)) -->
  159.      common_noun(N),
  160.      { Cond =.. [N,X] }.
  161.  
  162.  
  163. /*
  164.  *   noun_group --> proper_noun.
  165.  */
  166.  
  167. noun_group(entity(N,_,true)) -->
  168.      proper_noun(N).
  169.  
  170.  
  171. /**************
  172.  * Vocabulary *
  173.  **************/
  174.  
  175. copula(be)          --> [is];[are].
  176. aux_verb(do)        --> [do];[does].
  177. determiner(a)       --> [a];[an].
  178. determiner(null)    --> [].
  179.  
  180. verb(chase)         --> [chase];[chases].
  181. verb(see)           --> [see];[sees].
  182. verb(like)          --> [like];[likes].
  183.  
  184. adjective(green)    --> [green].
  185. adjective(brown)    --> [brown].
  186. adjective(big)      --> [big].
  187. adjective(little)   --> [little].
  188.  
  189. common_noun(dog)    --> [dog];[dogs].
  190. common_noun(cat)    --> [cat];[cats].
  191. common_noun(frog)   --> [frog];[frogs].
  192. common_noun(boy)    --> [boy];[boys].
  193. common_noun(girl)   --> [girl];[girls].
  194. common_noun(person) --> [person];[people].
  195. common_noun(child)  --> [child];[children].
  196. common_noun(animal) --> [animal];[animals].
  197.  
  198. proper_noun(cathy)  --> [cathy].
  199. proper_noun(fido)   --> [fido].
  200. proper_noun(felix)  --> [felix].
  201. proper_noun(kermit) --> [kermit].
  202.  
  203.  
  204. /*********************************
  205.  * Procedure to drive the parser *
  206.  *********************************/
  207.  
  208. /*
  209.  * parse(List,Structure)
  210.  *   parses List as a sentence, creating Structure.
  211.  */
  212.  
  213. parse(List,Structure) :-
  214.      phrase(sentence(Structure),List),
  215.      !.
  216.      /* Commit to this structure, even if there  */
  217.      /* are untried alternatives, because we are */
  218.      /* going to modify the knowledge base.      */
  219.  
  220. parse(_,'PARSE FAILED').
  221.      /* if the above rule failed */
  222.  
  223.  
  224. /*********************************
  225.  * Translation into Prolog rules *
  226.  *********************************/
  227.  
  228. /*
  229.  * make_rule(EntityList,Pred,Rule)
  230.  *   rearranges EntityList and Pred to make a Prolog-like rule,
  231.  *   which may be ill-formed (with a compound left side).
  232.  */
  233.  
  234. make_rule(EntityList,Pred,(Pred :- Conds)) :-
  235.    combine_conditions(EntityList,Conds).
  236.  
  237.  
  238. /*
  239.  * combine_conditions(EntityList,Result)
  240.  *   combines the conditions of all the entities
  241.  *   in EntityList to make a single compound goal.
  242.  */
  243.  
  244. combine_conditions([entity(_,_,Cond),Rest1|Rest], Cond & RestConds) :-
  245.    combine_conditions([Rest1|Rest],RestConds).
  246.  
  247. combine_conditions([entity(_,_,Cond)],Cond).
  248.  
  249.  
  250. /****************************
  251.  * Processing of statements *
  252.  ****************************/
  253.  
  254. /*
  255.  * dummy_item(X)
  256.  *   Creates a unique dummy individual (a structure of
  257.  *   the form dummy(N) where N is a unique number).
  258.  */
  259.  
  260. dummy_item(dummy(N)) :-
  261.      retract(dummy_count(N)),
  262.      NewN is N+1,
  263.      asserta(dummy_count(NewN)).
  264.  
  265. dummy_count(0).
  266.  
  267.  
  268. /*
  269.  * substitute_dummies(Det,Elist,NewElist)
  270.  *   Substitutes dummies for all the entities in Elist
  271.  *   whose determiners match Det and whose identifying
  272.  *   variables are not already instantiated.
  273.  *   If Det is uninstantiated, it is taken as matching
  274.  *   all determiners, not just the first one found.
  275.  */
  276.  
  277. substitute_dummies(Det,[Head|Tail],[NewHead|NewTail]) :-
  278.   !,
  279.   substitute_one(Det,Head,NewHead),
  280.   substitute_dummies(Det,Tail,NewTail).
  281.  
  282. substitute_dummies(_,[],[]).
  283.  
  284. substitute_one(Det,entity(V,D,Conds),entity(V,D,true)) :-
  285.   var(V),
  286.   (var(Det) ; Det == D),
  287.   !,
  288.   dummy_item(V),
  289.   assert_rule((Conds :- true)).
  290.  
  291. substitute_one(_,E,E).
  292.   /* for those that didn't match the above */
  293.  
  294.  
  295. /*
  296.  * assert_rule(Rule)
  297.  *   Adds Rule to the knowledge base.
  298.  *   If the left side is compound, multiple rules
  299.  *   with simple left sides are created.
  300.  */
  301.  
  302. assert_rule(((C1 & C2) :- Premises)) :-
  303.      !,
  304.      Rule = (C1 :- Premises),
  305.      message('Adding to knowledge base:'),
  306.      message(Rule),
  307.      assert(Rule),
  308.      assert_rule((C2 :- Premises)).
  309.  
  310. assert_rule(Rule) :-
  311.      /* Did not match the above */
  312.      message('Adding to knowledge base:'),
  313.      message(Rule),
  314.      assert(Rule).
  315.  
  316.  
  317. /***************************
  318.  * Processing of questions *
  319.  ***************************/
  320.  
  321. /*
  322.  * move_conditions_into_predicate(Det,E,P,NewE,NewP)
  323.  *   E and P are original entity-list and predicate, respectively.
  324.  *   The procedure searches E for entities whose determiner
  325.  *   matches Det, and transfers their conditions into P.
  326.  *   Results are NewE and NewP.
  327.  */
  328.  
  329. move_conditions_into_predicate(Det,[E1|E2],P,[E1|NewE2],NewP) :-
  330.      \+ (E1 = entity(_,Det,_)),
  331.      !,
  332.      /* No change needed in this one */
  333.      move_conditions_into_predicate(Det,E2,P,NewE2,NewP).
  334.  
  335. move_conditions_into_predicate(Det,[E1|E2],P,
  336.                                   [NewE1|NewE2],Conds & NewP) :-
  337.      E1 = entity(V,Det,Conds),
  338.      !,
  339.      NewE1 = entity(V,Det,true),
  340.      move_conditions_into_predicate(Det,E2,P,NewE2,NewP).
  341.  
  342. move_conditions_into_predicate(_,[],P,[],P).
  343.  
  344.  
  345. /*
  346.  * query_rule(Rule)
  347.  *   Tests whether Rule expresses a valid generalization.
  348.  *   This procedure always succeeds.
  349.  */
  350.  
  351. query_rule((Conclusion :- Premises)) :-
  352.      message('Testing generalization:'),
  353.      message(for_all(Premises,Conclusion)),
  354.      for_all(Premises,Conclusion),
  355.      !,
  356.      write('Yes.'),nl.
  357.  
  358. query_rule(_) :-
  359.      /* Above clause did not succeed */
  360.      write('No.'),nl.
  361.  
  362.  
  363. /*
  364.  * for_all(GoalA,GoalB)
  365.  *   Succeeds if:
  366.  *   (1) All instantiations that satisfy GoalA also satisfy GoalB,
  367.  *   (2) There is at least one such instantiation.
  368.  */
  369.  
  370. for_all(GoalA,GoalB) :-
  371.      \+ (call(GoalA), \+ call(GoalB)),
  372.      call(GoalA),
  373.      !.
  374.  
  375.  
  376. /******************
  377.  * User interface *
  378.  ******************/
  379.  
  380. /*
  381.  * message(Msg)
  382.  *   Prints Msg only if message_flag(true).
  383.  */
  384.  
  385. message(X) :-
  386.      message_flag(true),
  387.      !,
  388.      write(X),nl.
  389.  
  390. message(_).
  391.  
  392. message_flag(true).
  393.     /* Change to false to suppress messages */
  394.  
  395.  
  396. /*
  397.  * process(Structure)
  398.  *   Interprets and acts upon a sentence.
  399.  *   Structure is the output of the parser.
  400.  */
  401.  
  402. process('PARSE FAILED') :-
  403.              write('I do not understand.'),
  404.              nl.
  405.  
  406. process(statement(E,P)) :-
  407.              substitute_dummies(a,E,NewE),
  408.              make_rule(NewE,P,Rule),
  409.              assert_rule(Rule),
  410.              substitute_dummies(_,NewE,_).
  411.  
  412. process(question(E,P)) :-
  413.              move_conditions_into_predicate(a,E,P,NewE,NewP),
  414.              make_rule(NewE,NewP,Rule),
  415.              query_rule(Rule).
  416.  
  417.  
  418. /*
  419.  * go
  420.  *   Top-level loop to interact with user.
  421.  */
  422.  
  423. go :-  message(' '),
  424.        message('Enter a sentence:'),
  425.        readstring(String),nl,
  426.        tokenize(String,Words),
  427.        message('Parsing:'),
  428.        parse(Words,Structure),
  429.        message(Structure),
  430.        process(Structure),
  431.        go.
  432.  
  433.  
  434. /* Starting query */
  435.  
  436. start :-
  437.     write('NATURAL LANGUAGE UNDERSTANDER'),nl,
  438.     write('Copyright 1987 Michael A. Covington'),nl,
  439.     nl,
  440.     write('Type sentences. Terminate by pressing Ctrl-C.'),nl,
  441.     go.
  442.  
  443. :-start. 
  444.